home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / s / spiele / denk / schieber / editor3.gfa (.txt) next >
Encoding:
GFA-BASIC Atari  |  1996-11-17  |  16.5 KB  |  797 lines
  1. ' #############################################################################
  2. ' #                         æ  M O T E L S O F T  æ                           #
  3. ' #############################################################################
  4. '
  5. ' -----------------------------------------------------------------------------
  6. ' Arbeitstitel                >feldindex<
  7. ' -----------------------------------------------------------------------------
  8. '           CO.HARALD BREITMAIER  MARKUSPLATZ 3  7000 STUTTGART 1
  9. '                             TEL. 0711~640 22 87
  10. ' #############################################################################
  11. ' ----------> DATUM <------------           ---------->VERSION  1.0 <---------
  12. SETTIME "","28.06.88"
  13. ' #############################################################################
  14. ON ERROR GOSUB gfa1
  15. ON BREAK CONT
  16. ' ON BREAK GOSUB gfa2
  17. SETCOLOR 0,0
  18. SETCOLOR 15,7,7,7
  19. CLS
  20. GOSUB pic1
  21. ' -------------------------
  22. '
  23. number%=1                  !PASSWORT
  24. fx%=16                     !feldgrösse eintragen
  25. fy%=15
  26. xmax%=240                  !bildgrösse / BILDSCHIRMBEREICH
  27. ymax%=199                  !dato
  28. xx%=xmax% DIV fx%
  29. yy%=ymax% DIV fy%
  30. ' -------------------------
  31. farb%=2                    !def
  32. ' -------------------------
  33. DIM feld%(fx%+2,fy%+2)     !PLUS 2 WICHTIG BEI SPÄTEREN FELDABFRAGEN
  34. GOSUB bilo
  35. ' -------------------------
  36. GOSUB creat
  37. '
  38. ' -------------------------
  39. > PROCEDURE creat
  40.   ' -------------------------
  41.   ' -------------------------
  42.   x%=0
  43.   y%=0
  44.   DEFFILL 0,1,8
  45.   COLOR 1
  46.   ' -----
  47.   GOSUB rand1
  48.   FOR i%=1 TO fy%
  49.     FOR ii%=1 TO fx%
  50.       q1%=feld%(ii%,i%)
  51.       PUT x%,y%,bil$(q1%-1)     !  PBOX x%,y%,x%+xx%,y%+yy%
  52.       '                        BOX x%,y%,x%+xx%,y%+yy%
  53.       ADD x%,xx%
  54.     NEXT ii%
  55.     ADD y%,yy%
  56.     x%=0
  57.   NEXT i%
  58. tuees:
  59.   GOSUB maus(xx%,yy%,2,fx%-1,2,fy%-1)
  60.   '
  61.   GOTO tuees
  62. RETURN
  63. ' -------------------------
  64. PROCEDURE maus(sc1%,sc2%,sc3%,sc4%,sc5%,sc6%)
  65.   ' teiler x, teiler y,bereich <x >x bereich <y >y
  66.   '
  67.   '
  68. mausin:
  69.   PAUSE 1
  70.   SHOWM
  71.   '
  72.   REPEAT
  73.     b$=INKEY$
  74.     IF b$<>""
  75.       GOSUB action
  76.     ENDIF
  77.     ' -----
  78.     MOUSE x%,y%,k%
  79.     x%=x% DIV sc1%
  80.     y%=y% DIV sc2%
  81.     INC x%
  82.     INC y%
  83.     '
  84.     '    PRINT AT(1,23);x%;" ";y%;"  "
  85.     '
  86.   UNTIL k% OR b$="S"
  87.   ' -------------------------
  88.   IF b$="S"
  89.     GOTO mausex
  90.   ENDIF
  91.   ' -------------------------
  92.   x1%=x%-1
  93.   y1%=y%-1
  94.   ' -----
  95.   IF x%<sc3% OR x%>sc4%
  96.     GOTO mausin
  97.   ENDIF
  98.   IF y%<sc5% OR y%>sc6%
  99.     GOTO mausin
  100.   ENDIF
  101.   ' -------------------------
  102.   q1%=feld%(x%,y%)
  103.   ' -----
  104.   IF k%=2
  105.     feld%(x%,y%)=8            !7
  106.     '    DEFFILL 0
  107.     PUT (x1%*xx%),(y1%*yy%),bil$(7)   !(x1%*xx%)+xx%,(y1%*yy%)+yy%
  108.     '    COLOR 1
  109.     '    BOX (x1%*xx%),(y1%*yy%),(x1%*xx%)+xx%,(y1%*yy%)+yy%
  110.   ENDIF
  111.   ' -----
  112.   IF k%=1
  113.     feld%(x%,y%)=farb%
  114.     '    DEFFILL farb%
  115.     PUT (x1%*xx%),(y1%*yy%),bil$(farb%-1)      ! ,(x1%*xx%)+xx%,(y1%*yy%)+yy%
  116.     '    COLOR 1
  117.     '    BOX (x1%*xx%),(y1%*yy%),(x1%*xx%)+xx%,(y1%*yy%)+yy%
  118.   ENDIF
  119.   ' -------------------------
  120.   GOTO mausin
  121. mausex:
  122.   ' -----
  123.   GOSUB al(2," |FELD SPEICHERN",2," JA |NEIN")
  124.   ' -----
  125.   IF sc5%=2
  126.     GOTO mausin
  127.   ENDIF
  128.   ' -----
  129. nochmal:
  130.   GOSUB fils("A:\*.FLD","","DATEI SPEICHERN",2)
  131.   GOSUB extend(sc3$,"FLD") !FILESTRING EXTENDER
  132.   IF sc3$="---"            !ABBRUCH  - UNGÜLTIGER STRING
  133.     GOTO mausin
  134.   ENDIF
  135.   ff%=INSTR(sc3$,"LEVEL")
  136.   IF ff%=0
  137.     GOTO nochmal
  138.   ENDIF
  139.   ADD ff%,5
  140.   bbb$=MID$(sc3$,ff%,3)
  141.   number%=VAL(bbb$)
  142.   IF number%=0
  143.     number%=1
  144.   ENDIF
  145.   IF number%>100
  146.     number%=100
  147.   ENDIF
  148.   '
  149.   ' -------------------------
  150.   CLOSE #1
  151.   ' -----
  152.   OPEN "O",#1,sc3$
  153.   ' -----
  154.   WRITE #1,fx%+2       !GROESSE
  155.   WRITE #1,fy%+2
  156.   WRITE #1,xmax%
  157.   WRITE #1,ymax%
  158.   ' -----
  159.   FOR i%=1 TO fx%+2
  160.     FOR ii%=1 TO fy%+2
  161.       q1%=feld%(i%,ii%)
  162.       WRITE #1,q1%
  163.     NEXT ii%
  164.   NEXT i%
  165.   CLOSE #1
  166.   '
  167.   ' ------------------------------------
  168.   pass$=""
  169.   FOR i%=1 TO 5
  170.     pass%=RANDOM(20)+65
  171.     pass$=pass$+CHR$(pass%)
  172.   NEXT i%
  173.   CLOSE #1
  174.   '  PRINT AT(1,1);pass$
  175.   OPEN "R",#1,"A:\SCHIEBER\ZWEI.RAD",5
  176.   FIELD #1,5 AS pass$
  177.   PUT #1,number%
  178.   CLOSE #1
  179. RETURN
  180. ' -------------------------
  181. > PROCEDURE laden
  182.   ' -----
  183.   GOSUB fils("A:\*.FLD","","DATEI LADEN",2)
  184.   GOSUB extend(sc3$,"FLD") !FILESTRING EXTENDER
  185.   ' -----
  186.   IF sc3$="---"
  187.     GOTO ladenex
  188.   ENDIF
  189.   ' -------------------------
  190.   CLOSE #1
  191.   ' -----
  192.   OPEN "I",#1,sc3$
  193.   ' -----
  194.   INPUT #1,fx%        !GROESSE
  195.   INPUT #1,fy%
  196.   INPUT #1,xmax%
  197.   INPUT #1,ymax%
  198.   ' -----
  199.   ERASE feld%()
  200.   DIM feld%(fx%,fy%)
  201.   ' -----
  202.   FOR i%=1 TO fx%
  203.     FOR ii%=1 TO fy%
  204.       INPUT #1,q1%
  205.       feld%(i%,ii%)=q1%
  206.     NEXT ii%
  207.   NEXT i%
  208.   CLOSE #1
  209.   ' -----
  210.   SUB fx%,2
  211.   SUB fy%,2
  212.   xx%=xmax% DIV fx%
  213.   yy%=ymax% DIV fy%
  214.   ' -----
  215.   COLOR 1
  216.   ' -------------------------
  217.   ' -------------------------
  218.   x%=0
  219.   y%=0
  220.   ' -----
  221.   FOR i%=1 TO fy%
  222.     FOR ii%=1 TO fx%
  223.       ' -----
  224.       q1%=feld%(ii%,i%)
  225.       DEFFILL q1%
  226.       PUT x%,y%,bil$(q1%-1)                 !x%+xx%,y%+yy%
  227.       '      BOX x%,y%,x%+xx%,y%+yy%
  228.       ADD x%,xx%
  229.     NEXT ii%
  230.     ADD y%,yy%
  231.     x%=0
  232.   NEXT i%
  233.   ' -----
  234. ladenex:
  235. RETURN
  236. ' -------------------------
  237. > PROCEDURE action
  238.   b$=UPPER$(b$)
  239.   ' ----
  240.   IF b$="T"
  241.     GOSUB testlauf
  242.     GOTO actionex
  243.   ENDIF
  244.   ' -----
  245.   IF b$="S"
  246.     GOTO store
  247.   ENDIF
  248.   ' -----
  249.   IF b$="C"
  250.     ALERT 1," |FELD LÖSCHEN",2," JA |NEIN",ni%
  251.     IF ni%=1
  252.       GOSUB cl
  253.     ENDIF
  254.     GOTO actionex
  255.   ENDIF
  256.   ' -----
  257.   IF b$="G"
  258.     GOSUB al(1," |BOX-GRÖSSE :|X >"+STR$(xx%)+" Y >"+STR$(yy%),1,"OKAY")
  259.     GOTO actionex
  260.   ENDIF
  261.   ' -----
  262.   IF b$="L"
  263.     GOSUB al(2," |FELD LADEN",2," JA |NEIN")
  264.     IF sc5%=2
  265.       GOTO actionex
  266.     ENDIF
  267.     GOSUB laden
  268.     GOTO actionex
  269.   ENDIF
  270.   ' -----
  271.   IF b$="E"
  272.     GOSUB elite
  273.     GOTO actionex
  274.   ENDIF
  275.   ' -----
  276.   zz%=VAL(b$)
  277.   IF zz%=0
  278.     ALERT 1," |Q U I T T",2," JA |NEIN",sc5%
  279.     IF sc5%=1
  280.       STICK 0
  281.       '
  282.       CHDIR "\"
  283.       CHAIN "A:\SCHIEBER\SCHIEBER.GFA"
  284.     ENDIF
  285.     GOTO actionex
  286.   ENDIF
  287.   ' -----
  288.   INC zz%
  289.   ' -----
  290.   IF zz%>8
  291.     GOTO actionex
  292.   ENDIF
  293.   ' -----
  294.   farb%=zz%
  295.   ' -------------------------
  296. actionex:
  297.   b$=""
  298.   ' -----
  299. store:
  300. RETURN
  301. ' -------------------------
  302. > PROCEDURE cl
  303.   GOSUB rand1
  304.   x%=0
  305.   y%=0
  306.   DEFFILL 0,1,8
  307.   COLOR 1
  308.   ' -----
  309.   FOR i%=1 TO fy%
  310.     FOR ii%=1 TO fx%
  311.       q1%=feld%(ii%,i%)
  312.       PUT x%,y%,bil$(q1%-1)              !  PBOX x%,y%,x%+xx%,y%+yy%
  313.       '                              BOX x%,y%,x%+xx%,y%+yy%
  314.       ADD x%,xx%
  315.     NEXT ii%
  316.     ADD y%,yy%
  317.     x%=0
  318.   NEXT i%
  319.   ' -----
  320.   ' -----
  321. RETURN
  322. > PROCEDURE rand1
  323.   ARRAYFILL feld%(),8
  324.   FOR i%=1 TO fx%
  325.     feld%(i%,1)=2
  326.     feld%(i%,fy%)=2
  327.   NEXT i%
  328.   FOR i%=1 TO fy%
  329.     feld%(1,i%)=2
  330.     feld%(fx%,i%)=2
  331.   NEXT i%
  332. RETURN
  333. ' -------------------------
  334. > PROCEDURE al(sc1%,sc1$,sc2%,sc2$)
  335.   ALERT sc1%,sc1$,sc2%,sc2$,sc5%
  336. RETURN
  337. ' -------------------------
  338. > PROCEDURE elite
  339.   ' -------------------------
  340.   RESTORE datf1
  341.   FOR i%=1 TO 34
  342.     READ farbe%
  343.     fab$=fab$+CHR$(farbe%)
  344.   NEXT i%
  345.   ' -------------------------
  346.   '
  347.   '
  348.   ALERT 1,"screen abspeichern",1,"  Ja  |  Nein  ",ok%
  349.   IF ok%=2
  350.     GOTO eliteraus
  351.   ENDIF
  352.   '
  353.   GOSUB fils("A:\*.PI1","","BILD SPEICHERN",3)
  354.   GOSUB extend(sc3$,"PI1") !FILESTRING EXTENDER
  355.   IF sc3$="---"            !ABBRUCH  - UNGÜLTIGER STRING
  356.     GOTO eliteraus
  357.   ENDIF
  358.   HIDEM                  !maus weg
  359.   GOSUB bisa             !bildschirm abspeichern
  360.   '
  361. eliteraus:
  362.   '
  363. RETURN
  364. '
  365. > PROCEDURE bisa             !procedur speichert den bildschirm ab
  366.   '
  367. bisa:
  368.   CLOSE #1
  369.   OPEN "o",#1,sc3$
  370.   BPUT #1,VARPTR(fab$),34
  371.   BPUT #1,XBIOS(3),32032
  372.   CLOSE #1
  373.   '
  374. RETURN
  375. ' -------------------------
  376. > PROCEDURE extend(aa$,ex$)
  377.   ' -----
  378.   sc1$=""
  379.   sc2$=""
  380.   ' -----
  381.   IF aa$=""
  382.     sc3$="---"
  383.     GOTO exex
  384.   ENDIF
  385.   ' -----
  386.   ff%=LEN(aa$)
  387.   fff%=0
  388.   FOR i%=ff% DOWNTO 1
  389.     sc2$=MID$(aa$,i%,1)
  390.     IF sc2$="\"
  391.       fff%=i%
  392.     ENDIF
  393.     EXIT IF fff%
  394.   NEXT i%
  395.   ' -----
  396.   IF fff%=ff%
  397.     sc3$="---"
  398.     GOTO exex
  399.   ENDIF
  400.   ' -----
  401.   sc2$=LEFT$(aa$,fff%)
  402.   sc1$=RIGHT$(aa$,ff%-fff%)
  403.   ' -----
  404.   ff%=INSTR(sc1$,".")
  405.   IF ff%=0
  406.     sc1$=sc1$+"."+ex$
  407.   ENDIF
  408.   ' -----
  409.   IF ff%<>0
  410.     IF MID$(sc1$,ff%+1,3)<>ex$
  411.       MID$(sc1$,ff%+1,3)=ex$
  412.     ENDIF
  413.   ENDIF
  414.   ' -----
  415.   sc3$=sc2$+sc1$
  416.   ' -----
  417. exex:
  418. RETURN
  419. ' -------------------------
  420. > PROCEDURE fils(sc1$,sc2$,sc4$,sc1%)
  421.   ' PFAD,DATEI,WAS>LADEN/SPEICHERN,TEXTFARBE || ERGEBNIS IN SC3$
  422.   '
  423.   GET 0,0,319,14,sc5$
  424.   DEFTEXT sc1%,1,0,10
  425.   TEXT 0,12,319,sc4$
  426.   FILESELECT sc1$,sc2$,sc3$
  427.   PUT 0,0,sc5$
  428.   sc5$=""
  429. RETURN
  430. ' -------------------------
  431. > PROCEDURE bilo
  432.   DIM bil$(8)
  433.   '
  434.   FOR i%=1 TO 8
  435.     CLOSE #1
  436.     OPEN "i",#1,"A:\SCHIEBER\ART\test"+STR$(i%)+".qim"
  437.     bil$(i%)=INPUT$((LOF(#1)),#1)
  438.     CLOSE #1
  439.   NEXT i%
  440.   '
  441.   DIM fahr$(5)
  442.   '
  443.   FOR i%=1 TO 5
  444.     CLOSE #1
  445.     OPEN "i",#1,"a:\SCHIEBER\ART\fahr"+STR$(i%)+".qim"
  446.     fahr$(i%)=INPUT$((LOF(#1)),#1)
  447.     CLOSE #1
  448.   NEXT i%
  449. RETURN
  450. ' --------------------------testlaufen------------------------------'
  451. > PROCEDURE testlauf
  452. tstart:
  453.   SGET zum$
  454.   GOSUB testin
  455.   PUT 15,13,fahr$(2)
  456.   STICK 1
  457.   REPEAT
  458.     feuer#=STRIG(1)
  459.     PRINT AT(1,1);"TESTLAUF"
  460.   UNTIL feuer#=FALSE
  461.   '
  462.   ax%=15       !bildformat
  463.   ay%=13
  464.   ' -----
  465.   m1%=7        !feld zum laufen
  466.   m2%=3        !kiste
  467.   m3%=4        !obenunten
  468.   m5%=5        !WOHIN ??
  469.   ' -------------------------
  470.   x%=1
  471.   y%=1
  472.   sx%=1
  473.   sy%=1
  474.   ' -----
  475.   PUT 15,13,fahr$(2)
  476.   '
  477. thaupt:
  478.   '
  479.   ' PRINT AT(1,23);sx%;" ";sy%;" "
  480.   ' -------------------------
  481.   PAUSE 5
  482.   ' ------
  483.   GOSUB joy
  484.   ' ------
  485.   IF feuer#=TRUE
  486.     STICK 0
  487.     SPUT zum$
  488.     GOTO testende
  489.   ENDIF
  490.   ' -----
  491.   ' -----
  492.   IF x%<0 OR x%>20 OR y%<0 OR y%>15
  493.     GOTO thaupt
  494.   ENDIF
  495.   ' -----
  496.   ' -------------------------
  497.   IF x%>sx%+1
  498.     GOTO thaupt
  499.   ENDIF
  500.   ' -----
  501.   IF x%<sx%-1
  502.     GOTO thaupt
  503.   ENDIF
  504.   ' -----
  505.   IF y%>sy%+1
  506.     GOTO thaupt
  507.   ENDIF
  508.   ' -----
  509.   IF y%<sy%-1
  510.     GOTO thaupt
  511.   ENDIF
  512.   ' -----
  513.   was%=f%(x%+1,y%+1)
  514.   ' -----
  515.   SELECT was%
  516.     '  PRINT AT(1,24);was%;"<<"
  517.     ' -----
  518.   CASE 2,5,7
  519.     frei%=0
  520.   CASE 4                     !###################
  521.     IF y%=sy%+1 OR y%=sy%-1
  522.       frei%=0
  523.     ELSE
  524.       frei%=1
  525.     ENDIF
  526.   CASE 6                     !##################
  527.     IF x%=sx%+1 OR x%=sx%-1
  528.       frei%=0
  529.     ELSE
  530.       frei%=1
  531.     ENDIF
  532.   DEFAULT
  533.     frei%=1
  534.   ENDSELECT
  535.   ' PRINT AT(33,7);frei%;" "
  536.   ' -------------------------
  537.   IF frei%=0          !FELD FREI
  538.     PUT (sx%)*ax%,(sy%)*ay%,bil$(ff%(sx%+1,sy%+1))
  539.     ' -----
  540.     PUT x%*ax%,y%*ay%,fahr$(fa%)
  541.     sx%=x%
  542.     sy%=y%
  543.     GOTO weiter4          !gelaufen
  544.   ENDIF
  545.   IF frei%<>0 AND was%<>3
  546.     GOTO weiter4   !#####################
  547.   ENDIF
  548.   ' -------------------------
  549.   zx%=x%+1               !FELDPOSITION
  550.   zy%=y%+1               !FELDPOSITION
  551.   ' -----
  552.   ' -----
  553.   IF sx%=x%                  !hoch runter
  554.     ' -----
  555.     IF y%=sy%-1              !HOCH
  556.       GOSUB hoch
  557.       GOTO weiter3
  558.     ENDIF
  559.     ' -----
  560.     IF y%=sy%+1              !RUNTER
  561.       GOSUB runter
  562.       GOTO weiter3
  563.     ENDIF
  564.     ' -----
  565.   ENDIF
  566.   ' -------------------------
  567.   ' -------------------------
  568.   IF sy%=y%                  !LINKS RECHTS
  569.     ' -----
  570.     IF x%=sx%-1              !LINKS
  571.       GOSUB links
  572.       GOTO weiter3
  573.     ENDIF
  574.     ' -------------------------
  575.     IF x%=sx%+1               !RECHTS#######################################
  576.       GOSUB rechts
  577.     ENDIF
  578.     GOTO weiter3
  579.   ENDIF
  580.   ' -----
  581. weiter3:
  582.   PAUSE 5
  583. weiter4:
  584.   ' -----
  585.   GOTO thaupt
  586.   ' --------------------------
  587. testende:
  588. RETURN
  589. ' -------------------------
  590. > PROCEDURE joy
  591. joyin:
  592.   x%=sx%
  593.   y%=sy%
  594.   '
  595.   feuer#=STRIG(1)
  596.   IF feuer#=TRUE
  597.     GOTO joyex
  598.   ENDIF
  599.   '
  600.   richtung%=STICK(1)
  601.   SELECT richtung%
  602.   CASE 4
  603.     DEC x%
  604.     fa%=1
  605.   CASE 8
  606.     INC x%
  607.     fa%=2
  608.   CASE 2
  609.     INC y%
  610.     fa%=5
  611.   CASE 1
  612.     DEC y%
  613.     fa%=4
  614.   ENDSELECT
  615.   IF x%=sx% AND y%=sy%
  616.     GOTO joyin
  617.   ENDIF
  618. joyex:
  619. RETURN
  620. ' -------------------------
  621. > PROCEDURE hoch
  622.   ' -----
  623.   w2%=f%(zx%,zy%)            !1 FELD DANACH
  624.   w3%=f%(zx%,zy%-1)          !2 FELD DANACH
  625.   IF w2%<2 OR w3%=m2%       !WAND
  626.     GOTO hochex             !KEIN LAUFEN
  627.   ENDIF
  628.   ' -----
  629.   IF w2%=m2% AND w3%>1       !KISTE UND EXTRAFELD ODER LAUFEN
  630.     w4%=ff%(zx%,zy%)       !KISTENFELD
  631.     IF w4%=m2%               !AUCH KISTE   WEG DAMIT
  632.       ff%(zx%,zy%)=m1%     !NUN LAUFFELD
  633.     ENDIF
  634.   ELSE
  635.     GOTO hochex
  636.   ENDIF
  637.   PUT sx%*ax%,sy%*ay%,bil$(ff%(sx%+1,sy%+1)) !FELD ALTE POSITION
  638.   PUT x%*ax%,y%*ay%,fahr$(fa%)            !SPIELFIGUR
  639.   PUT x%*ax%,(y%-1)*ay%,bil$(m2%)          !KISTE
  640.   f%(zx%,zy%-1)=m2%                      !DA STEHT SIE NUN
  641.   f%(zx%,zy%)=ff%(zx%,zy%)
  642.   sx%=x%
  643.   sy%=y%
  644. hochex:
  645. RETURN
  646. ' -------------------------
  647. > PROCEDURE runter
  648.   ' -----
  649.   w2%=f%(zx%,zy%)          !1 FELD DANACH
  650.   w3%=f%(zx%,zy%+1)          !2 FELD DANACH
  651.   IF w2%<2 OR w3%=m2%                  !WAND
  652.     GOTO rraus            !KEIN LAUFEN
  653.   ENDIF
  654.   ' -----
  655.   IF w2%=m2% AND w3%>1       !KISTE UND EXTRAFELD ODER LAUFEN
  656.     w4%=ff%(zx%,zy%)           !KISTENFELD
  657.     IF w4%=m2%               !AUCH KISTE   WEG DAMIT
  658.       ff%(zx%,zy%)=m1%       !NUN LAUFFELD
  659.     ENDIF
  660.   ELSE
  661.     GOTO rraus
  662.   ENDIF
  663.   PUT sx%*ax%,sy%*ay%,bil$(ff%(sx%+1,sy%+1)) !FELD ALTE POSITION
  664.   PUT x%*ax%,y%*ay%,fahr$(fa%)         !SPIELFIGUR
  665.   PUT x%*ax%,(y%+1)*ay%,bil$(m2%)       !KISTE
  666.   f%(zx%,zy%+1)=m2%                      !DA STEHT SIE NUN
  667.   f%(zx%,zy%)=ff%(zx%,zy%)
  668.   sx%=x%
  669.   sy%=y%
  670. rraus:
  671. RETURN
  672. ' -------------------------
  673. > PROCEDURE links
  674.   ' -----
  675.   w2%=f%(zx%,zy%)          !1 FELD DANACH
  676.   w3%=f%(zx%-1,zy%)          !2 FELD DANACH
  677.   IF w2%<2 OR w3%=m2%                 !WAND
  678.     GOTO linksex             !KEIN LAUFEN
  679.   ENDIF
  680.   ' -----
  681.   IF w2%=m2% AND w3%>1       !KISTE UND EXTRAFELD ODER LAUFEN
  682.     w4%=ff%(zx%,zy%)       !KISTENFELD
  683.     IF w4%=m2%               !AUCH KISTE   WEG DAMIT
  684.       ff%(zx%,zy%)=m1%     !NUN LAUFFELD
  685.     ENDIF
  686.   ELSE
  687.     GOTO linksex
  688.   ENDIF
  689.   PUT sx%*ax%,sy%*ay%,bil$(ff%(sx%+1,sy%+1)) !FELD ALTE POSITION
  690.   PUT x%*ax%,y%*ay%,fahr$(fa%)         !SPIELFIGUR
  691.   PUT (x%-1)*ax%,y%*ay%,bil$(m2%)            !KISTE
  692.   f%(zx%-1,zy%)=m2%                      !DA STEHT SIE NUN
  693.   f%(zx%,zy%)=ff%(zx%,zy%)
  694.   sx%=x%
  695.   sy%=y%
  696. linksex:
  697. RETURN
  698. ' -------------------------
  699. > PROCEDURE rechts
  700.   ' -----
  701.   w2%=f%(zx%,zy%)          !1 FELD DANACH
  702.   w3%=f%(zx%+1,zy%)          !2 FELD DANACH
  703.   IF w2%<2 OR w3%=m2%                 !WAND
  704.     GOTO rechtsex            !KEIN LAUFEN
  705.   ENDIF
  706.   ' -----
  707.   IF w2%=m2% AND w3%>1       !KISTE UND EXTRAFELD ODER LAUFEN
  708.     w4%=ff%(zx%,zy%)       !KISTENFELD
  709.     IF w4%=m2%               !AUCH KISTE   WEG DAMIT
  710.       ff%(zx%,zy%)=m1%     !NUN LAUFFELD
  711.     ENDIF
  712.   ELSE
  713.     GOTO rechtsex
  714.   ENDIF
  715.   PUT sx%*ax%,sy%*ay%,bil$(ff%(sx%+1,sy%+1)) !FELD ALTE POSITION
  716.   PUT x%*ax%,y%*ay%,fahr$(fa%)         !SPIELFIGUR
  717.   PUT (x%+1)*ax%,y%*ay%,bil$(m2%)            !KISTE
  718.   f%(zx%+1,zy%)=m2%                      !DA STEHT SIE NUN
  719.   f%(zx%,zy%)=ff%(zx%,zy%)
  720.   sx%=x%
  721.   sy%=y%
  722. rechtsex:
  723. RETURN
  724. ' ----------------------testlauf ende---------------------------
  725. > PROCEDURE testin
  726.   ERASE f%()
  727.   ERASE ff%()
  728.   ERASE fff%()
  729.   ' -----
  730.   DIM f%(fx%,fy%)
  731.   DIM ff%(fx%,fy%)
  732.   DIM fff%(fx%,fy%)
  733.   ' -----
  734.   FOR i%=1 TO fx%
  735.     FOR ii%=1 TO fy%
  736.       q1%=feld%(i%,ii%)
  737.       DEC q1%
  738.       f%(i%,ii%)=q1%
  739.       ff%(i%,ii%)=q1%
  740.       fff%(i%,ii%)=q1%
  741.     NEXT ii%
  742.   NEXT i%
  743.   '
  744. RETURN
  745. ' ----------------------------pro bilo-------------------------------
  746. '
  747. > PROCEDURE pic1
  748.   '
  749.   CLOSE #1
  750.   OPEN "i",#1,"A:\SCHIEBER\ART\EDITOR.PI1"
  751.   farb$=SPACE$(34)                  !originalfarben des bildes laden
  752.   BGET #1,VARPTR(farb$),34          !und in string farb$ ablegen
  753.   z%=0
  754.   FOR i%=3 TO LEN(farb$) STEP 2     !jeweils 2 werte ergeben die farbe
  755.     farb1$=MID$(farb$,i%)             !wert 1
  756.     farb2$=MID$(farb$,i%+1)           !wert 2
  757.     a%=ASC(farb1$)                    !ascii code
  758.     b%=ASC(farb2$)                    !asci code
  759.     c%=a%*256+b%                      !wandeln in farbcode
  760.     SETCOLOR z%,c%                    !in die farbregister damit
  761.     INC z%                            !hilfszahler
  762.   NEXT i%
  763.   BGET #1,XBIOS(3),32000            !bild laden
  764.   CLOSE #1
  765. RETURN
  766. ' -----------------------
  767. > PROCEDURE gfa1
  768.   STICK 0
  769.   SETCOLOR 0,7,7,7
  770.   SETCOLOR 15,0
  771.   CLS
  772.   PRINT AT(1,1);"EIN FEHLER IST AUFGETRETEN"
  773.   PRINT AT(1,2);ERR$(ERR)
  774.   '
  775.   VOID INP(2)
  776.   EDIT
  777. RETURN
  778. ' ----------------------
  779. > PROCEDURE gfa2
  780.   STICK 0
  781.   SETCOLOR 0,7,7,7
  782.   SETCOLOR 15,0
  783.   CLS
  784.   PRINT AT(1,1);"STOP DURCH BREAK"
  785.   PRINT "FREE BYTES ";FRE(9)
  786.   '
  787.   VOID INP(2)
  788.   EDIT
  789. RETURN
  790. ' -----------------------
  791. '
  792. datf1:      !GERINGE AUFLÖSUNG
  793. '
  794. DATA 0,0,7,119
  795. DATA 7,0,0,112,7,112,0,7,7,7,0,119,5,85,3,51,7,51,3,115,7,115,3,55,7,55,3,119
  796. DATA 0,0
  797.